home *** CD-ROM | disk | FTP | other *** search
- /* Puts up the MEDSTAT Credits Window. */!!
-
- inherit(Window, #CreditsWindow, #(bitmaps /* dictionary of bitmaps */
- colors /* dictionary of colors */
- font /* Credits font */), 2, nil)!!
-
-
- now(class(CreditsWindow))!!
-
- /* Return the default window style for an About. */
- Def style(self)
- { ^WS_POPUP bitOr WS_DLGFRAME;
- }!!
-
- /* Create and start a new Credits object. */
- Def start(self)
- { ^new(self, nil, nil, " ", nil);
- }!!
-
- /* Return static string for this window class name ("ActorCredits"). */
- Def wndClass(self)
- { ^"CalmCreditsWindow";
- }!!
-
- now(CreditsWindow)!!
-
- /* This space for rent. */
- Def drawText(self, str, fontStyle, rect, style | hDC)
- { if alive(self)
- then hDC := getContext(self);
- Call SetTextColor(hDC, 0x000000L);
- Call SetBkMode(hDC, TRANSPARENT);
- Call SelectObject(hDC, fontStyle);
- Call DrawText(hDC, asciiz(str), -1, rect, style);
- releaseContext(self, hDC);
- endif;
- }
- !!
-
- /* This space for rent. */
- Def getCredit(self, idx | loadStr, strColl, stream, name)
- { loadStr := loadString(idx + 2001);
- stream := streamOver(loadStr);
- strColl := new(OrderedCollection, 4);
- loop
- while name := word(stream, ',')
- begin add(strColl, name);
- endLoop;
-
- ^strColl
- }
- !!
-
- /* Scroll the passed rectangle count times by the amount
- specified by point. */
- Def scrollRectSlow(self, rect, point, count);
- { alive(self) cand checkMessage();
- if alive(self)
- then
- loop
- Call ScrollWindow(hWnd, x(point), y(point), rect, rect);
- update(self);
- while (count := count - 1) > 0
- delay(self, 50);
- endLoop;
- endif;
- }!!
-
- /* Draw the credits in movie form. */
- Def drawCredits(self | hDC, count, idx, credit, rect1, rect2)
- { rect1 := rect(120, 65, 305, 200);
- rect2 := rect(120, 180, 305, 197);
- idx := -1;
- loop
- checkMessage();
- while alive(self) cand (idx := idx + 1) < 10
- credit := getCredit(self, idx);
- do(credit,
- { using(name)
- if name = credit[0]
- then drawText(self, name, font[1], rect2, 0x25);
- else drawText(self, name, font[0], rect2, 0x25);
- endif;
- scrollRectSlow(self, rect1, point(0, -2), (height(rect2) / 2));
- });
- scrollRectSlow(self, rect1, point(0, -2), (height(rect2) / 2)*4);
- endLoop;
- scrollRectSlow(self, rect1, point(0, -2), (height(rect2) / 2)*4);
- }
- !!
-
- /* Return a valid position in the about box for a firework. */
- Def getPos(self | x, y)
- { x := random(368);
- y := random(165);
- select
- case x < 45 y := min(y, 134) endCase
- case x >= 55 and x < 185 y := max(65, y) endCase
- case x >= 185 and x < 342 y := min(max(65, y), 100) endCase
- case x >= 343 y := min(y, 100) endCase
- endSelect;
- ^point(x,y)
- }!!
-
- /* Evaluate the drawing block with the passed parameters. */
- Def doDraw(self, bitmap, color, aBlk | hDC, hMemDC)
- { if alive(self)
- then hDC := getContext(self);
- hMemDC := Call CreateCompatibleDC(hDC);
- Call SelectObject(hMemDC, bitmap[0]);
- if bitmap[5] = SRCCOPY
- then Call SetBkColor(hDC, Call GetNearestColor(hDC, 0xFFFFFFL));
- Call SetTextColor(hDC, color);
- endif;
- if bitmap[5] = NOTSRCCOPY
- then Call SetBkColor(hDC, Call GetNearestColor(hDC, 0x000000L));
- Call SetTextColor(hDC, 0x000000L);
- endif;
- eval(aBlk, bitmap, hDC, hMemDC);
- Call DeleteDC(hMemDC);
- releaseContext(self, hDC);
- endif;
- }!!
-
- /* Draw the version number bitmap. */
- Def drawFirework(self | color, pos, pos)
- { color := colors[#(#red, #green, #blue, #purple)[random(4)]];
- pos := getPos(self);
- do(2,
- { using(count)
- doDraw(self, bitmaps[#firework], color,
- { using(bitmapArray, hDC, hMemDC)
- Call BitBlt(hDC, x(pos)+18, y(pos)+18, 9, 9,
- hMemDC, 18, 18, bitmapArray[5]);
- });
- delay(self, 250);
- doDraw(self, bitmaps[#firework], color,
- { using(bitmapArray, hDC, hMemDC)
- Call BitBlt(hDC, x(pos)+9, y(pos)+9, 27, 27,
- hMemDC, 9, 9, bitmapArray[5]);
- });
- delay(self, 250);
- doDraw(self, bitmaps[#firework], color,
- { using(bitmapArray, hDC, hMemDC)
- Call BitBlt(hDC, x(pos), y(pos), 45, 45,
- hMemDC, 0, 0, bitmapArray[5]);
- });
- if alive(self) bitmaps[#firework][5] := NOTSRCCOPY; endif;
- });
- if alive(self) bitmaps[#firework][5] := SRCCOPY; endif;
- }!!
-
- /* Draw the copyright information. */
- Def drawCopyright(self | hDC, count, idx, str, rect1, rect2)
- { rect1 := rect(265, 145, 400, 200);
- rect2 := rect(265, 180, 400, 197);
- idx := -1;
- loop
- checkMessage();
- while alive(self) cand (idx := idx + 1) < 3
- scrollRect(self, rect1, point(0, -2), height(rect2) / 2);
- drawText(self, loadString(idx + 1996), font[0], rect2, 0x22);
- endLoop;
- scrollRect(self, rect1, point(0, -2), 2);
- }
- !!
-
- /* Draw the copyright information. */
- Def drawVersion(self | hDC, rect1, rect2, path, dir, bounce)
- { rect1 := rect(305, 0, 412, 210);
- rect2 := rect(0, 70, 412, 210);
- path := new(Array, 7);
- path[0] := point(-3, -9); path[4] := point(-3, 1);
- path[1] := point(-3, -4); path[5] := point(-3, 4);
- path[2] := point(-3, -1); path[6] := point(-3, 9);
- path[3] := point(-3, 0);
- bounce := #( #(8,8,5,4,5,8,8)
- #(6,6,3,2,3,6,6)
- #(4,4,2,1,2,4,4));
-
- hDC := getContext(self);
- Call SetTextColor(hDC, 0x000000L);
- Call SetBkMode(hDC, TRANSPARENT);
- Call DrawText(hDC, asciiz(loadString(1999)), -1, rect1, 0x22 /*DT_SINGLELINE*/);
- releaseContext(self, hDC);
-
- dir := 5; /* Drop it */
- do(#(8,16),
- { using(amount)
- scrollRect(self, rect1, path[dir], amount);
- dir := dir + 1;
- });
-
- do(bounce, /* bounce it */
- { using(count)
- dir := 0;
- do(count,
- { using(amount)
- scrollRect(self, rect2, path[dir], amount);
- dir := dir + 1;
- })
- });
- }!!
-
- /* Draw the version number bitmap. */
- Def drawLogo(self | bitmapSize, frontCol, tmp)
- { bitmapSize := bitmaps[#version][3] / 3;
- frontCol := 0;
- tmp := -1;
- do(overBy(34, 0, -1),
- { using(col)
- /* Do a strip of MED */
- doDraw(self, bitmaps[#version], colors[#blue],
- { using(bitmapArray, hDC, hMemDC)
- Call BitBlt(hDC, bitmapArray[1] + (col * 3), bitmapArray[2],
- 3, bitmapArray[4], hMemDC, (col * 3), 0, bitmapArray[5]);
- });
- tmp := tmp + 2;
- frontCol := col + tmp;
- /* Do a strip of STAT */
- doDraw(self, bitmaps[#version], colors[#red],
- { using(bitmapArray, hDC, hMemDC)
- Call BitBlt(hDC, bitmapArray[1] + (frontCol * 3), bitmapArray[2],
- 3, bitmapArray[4], hMemDC, (frontCol * 3), 0, bitmapArray[5]);
- });
- delay(self, 75);
- });
- /* Finish off STAT */
- do(over(frontCol, bitmapSize),
- { using(col)
- doDraw(self, bitmaps[#version], colors[#red],
- { using(bitmapArray, hDC, hMemDC)
- Call BitBlt(hDC, bitmapArray[1] + (col * 3), bitmapArray[2],
- 3, bitmapArray[4], hMemDC, (col * 3), 0, bitmapArray[5]);
- });
- });
- }!!
-
- /* Draw the copyright information. */
- Def drawSystem2(self | hDC, rect1)
- { rect1 := rect(0, 50, 305, 65);
- hDC := getContext(self);
- Call SetTextColor(hDC, 0x000000L);
- Call SetBkMode(hDC, TRANSPARENT);
- Call DrawText(hDC, asciiz("System2"), -1, rect1, 0x20 /*DT_SINGLELINE*/);
- releaseContext(self, hDC);
- scrollRect(self, rect1, point(2, 0), 125);
- }!!
-
- /* If the window is not closed, then close it. */
- Def close(self)
- { deleteBitmaps(self);
- close(self:ancestor);
- }!!
-
- /* Check if window still on screen. */
- Def alive(self)
- { ^hWnd cand bitmaps cand font
- }!!
-
- /* Inform the class that there is no longer an
- about window object in the system. */
- Def WM_NCDESTROY(self, wp, lp | ret)
- { ret := WM_NCDESTROY(self:ancestor, wp, lp);
- ^ret
- }!!
-
- /* Initialize the window characteristics before showing
- the window. */
- Def winit(self | x, y, hDC, logFont)
- { x := (x(screenSize()) - 425) / 2;
- y := (y(screenSize()) - 210) / 2;
- setCRect(self, rect(x, y, x+425, y+210));
- moveWindow(self);
-
- /* Set the background to the color nearest dark blue */
- hDC := Call GetDC(0);
- Call SetClassWord(getHWnd(self), GCW_HBRBACKGROUND,
- Call CreateSolidBrush(Call GetNearestColor(hDC, 0xFFFFFFL))
- );
- Call ReleaseDC(0, hDC);
-
- Call SetCapture(hWnd);
- colors := new(Dictionary, 4);
- colors[#red] := 0x0000FF;
- colors[#green] := 0x20FF00;
- colors[#blue] := 0xFF0000;
- colors[#purple] := 0xFF009F;
-
- font := new(Array, 2);
- logFont := new(Struct, 30); /* Select a variable-pitch font. */
- putWord(logFont, 18, 0);
- putLSB(logFont, 2, 17);
- font[0] := Call CreateFontIndirect(lP(logFont));
- freeHandle(logFont);
-
- putWord(logFont, 700, 8); /* 700 = bold */
- putWord(logFont, 1, 11); /* Underline on */
- font[1] := Call CreateFontIndirect(lP(logFont));
- freeHandle(logFont);
- }!!
-
- /* Paint the about window */
- Def WM_TIMER(self, wP, lP)
- { Call KillTimer(getHWnd(self), wP);
- if alive(self)
- then update(self);
- drawBox(self);
- endif;
- close(self);
- }!!
-
- /* Close window when the left mouse button is pressed. */
- Def WM_LBUTTONDOWN(self, wP, lP | hDC, x)
- { deleteBitmaps(self);
- }!!
-
- /* Close window when focus is given to another window. */
- Def WM_KILLFOCUS(self, wP, lP)
- { deleteBitmaps(self);
- }!!
-
- /* Close window when any key is pressed. */
- Def WM_KEYDOWN(self, wP, lP)
- { if not(wP in #(16 17))
- then deleteBitmaps(self);
- endif;
- }!!
-
- /* If bitmaps still exists when the window is destroyed,
- get rid of them. */
- Def WM_DESTROY(self, wp, lp)
- { if alive(self)
- then deleteBitmaps(self);
- endif;
- Call CloseSound();
- Call DeleteObject(
- Call SetClassWord(hWnd, GCW_HBRBACKGROUND, COLOR_WINDOW + 1)
- );
- Call ReleaseCapture();
- ^WM_DESTROY(self:ancestor, wp, lp);
- }!!
-
- /* Scroll the passed rectangle count times by the amount
- specified by point. */
- Def scrollRect(self, rect, point, count);
- { alive(self) cand checkMessage();
- if alive(self)
- then
- loop
- Call ScrollWindow(hWnd, x(point), y(point), rect, rect);
- update(self);
- while (count := count - 1) > 0
- endLoop;
- endif;
- }!!
-
- /* Draw the items in the window. */
- Def drawBox(self)
- { alive(self) cand drawLogo(self);
- delay(self, 1000);
- alive(self) cand drawSystem2(self);
- delay(self, 1000);
- alive(self) cand drawVersion(self);
- alive(self) cand drawCredits(self);
- alive(self) cand drawCopyright(self);
- loop
- alive(self) cand drawFirework(self);
- delay(self, 750);
- while alive(self)
- endLoop;
- }!!
-
- /* Delete all the allocated bitmaps. */
- Def deleteBitmaps(self)
- { do(bitmaps,
- {using(i | hBitmap)
- if (hBitmap := i[0]) <> 0
- then Call DeleteObject(hBitmap);
- endif;
- });
- bitmaps := nil;
- do(size(font),
- { using(idx) Call DeleteObject(font[idx]);
- });
- font := nil;
- }!!
-
- /* Setup all the bitmaps. */
- Def setBitmaps(self | bitmap, struct, mode, hDC)
- { bitmaps := new(Dictionary, 8);
- struct := new(Struct, 14);
-
- hDC := Call GetDC(0);
- if (Call GetDeviceCaps(hDC, 24 /*NUMCOLORS*/) < 3)
- then mode := NOTSRCCOPY;
- else mode := SRCCOPY;
- endif;
- Call ReleaseDC(0, hDC);
-
-
- if (bitmap := Call LoadBitmap(HInstance, 900)) <> 0
- then Call GetObject(bitmap, size(struct), struct);
- bitmaps[#version] := tuple(bitmap, 100, 10, wordAt(struct, 2), wordAt(struct, 4), mode);
- else ^nil;
- endif;
-
- if (bitmap := Call LoadBitmap(HInstance, 901)) <> 0
- then Call GetObject(bitmap, size(struct), struct);
- bitmaps[#firework] := tuple(bitmap, 0, 0, wordAt(struct, 2), wordAt(struct, 4), mode);
- else ^nil;
- endif;
- }!!
-
- /* Initialize the about window object. */
- Def init(self | x, y, hDC)
- { if not(setBitmaps(self))
- then destroy(self);
- ^nil
- endif;
- }!!
-
- /* Create and run an Credits Box. */
- Def runModal(self, dummy, par)
- { parent := par;
- winit(self);
- show(self, 1);
- Call SetTimer(getHWnd(self), 0x17, 1, 0);
- }!!
-
- /* Routine for causing a delay. */
- Def delay(self, count | sT, lCount)
- { if alive(self)
- then sT := asLong(Call GetCurrentTime());
- lCount := asLong(count);
- loop
- alive(self) cand checkMessage();
- while alive(self) cand ((Call GetCurrentTime() - sT:Long) bitAnd 0x7FFFFFFFL) < lCount:Long
- endLoop;
- endif;
- }!!